home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / GrafSys 2.0 / Demos / Orbit ƒ / orbits.OS < prev    next >
Encoding:
Text File  |  1993-08-17  |  5.5 KB  |  223 lines  |  [TEXT/PJMM]

  1. program Orbits;
  2.  
  3. { demo program for grafsys, © 1993 by C. Franz }
  4. {}
  5. { this demo demonstrates inheritance and arbitrary rotation }
  6.  
  7. {this demo program shows three spheres that orbit each other. They are }
  8. {essentially three objects. Sun, Planet and moon are one object each       }
  9.  
  10. {This demo shows the difference between normal drawing and off-screen }
  11. {drawing for flicker-free animations }
  12.  
  13.     uses
  14.         Matrix, Transformations, OffscreenCore, GrafSysCore, GrafSysScreen, GrafSysObject, Resources, OffScreenGraphics;
  15.  
  16.     const
  17.         degrees = 0.01745329; (* π/180 *)
  18.         cTheWindow = 400;
  19.  
  20.     type
  21.         SolarSystem = object
  22.                 sun: TSGenericObject3D;
  23.                 planet: TSGenericObject3D;
  24.                 moon: TSGenericObject3D;
  25.                 SunRad: real;
  26.                 PlanetRad: real;
  27.                 MoonRad: Real;
  28.                 frame: rect;
  29.                 oldFrame: rect; (* used for off-screen copying *)
  30.                 procedure Init;
  31.                 procedure Draw;
  32.                 procedure Animate;
  33.             end;
  34.  
  35.     var
  36.         Sol: SolarSystem;
  37.  
  38. {CalcObjectFrame : calculates the rect that will contain the sphere         }
  39. {                        uses the same perspective projection that usually is    }
  40. {                        used by grafsys                                                }
  41. {     v             contains the (transformed) wc of the sphere's center            }
  42. {     radius     is the size of the shpere                                             }
  43. {     theRect    returns the rect used for drawing the sphere                     }
  44.  
  45.     procedure CalcObjectFrame (v: vector4; radius: real; var theRect: Rect; var z: real);
  46.  
  47.         var
  48.             zbyd: real;
  49.             x, y: real;
  50.             sx, sy, sr: integer;
  51.  
  52.     begin
  53.         GetVector4(v, x, y, z); (* get the sphere's z *)
  54.         ProjectPoint(v, sx, sy);(* use this as center for the rect *)
  55.         SetRect(theRect, sx, sy, sx, sy);
  56.  
  57.         zbyd := 1 / (z / current3DPort^.d + 1);
  58.         sr := Trunc(radius * zbyd); (* project the radius *)
  59.         InsetRect(theRect, -sr, -sr);
  60.     end;
  61.  
  62. { Methods }
  63.     procedure SolarSystem.Init;
  64.         var
  65.             thePass: TMatrixPass;
  66.             OK: LongInt;
  67.  
  68.     begin
  69.         New(Sun);
  70.         Sun.Init;
  71.         OK := Sun.AddPoint(0, 0, 0);
  72.         New(Planet);
  73.         Planet.Init;
  74.         OK := Planet.AddPoint(0, 0, 0);
  75.         New(Moon);
  76.         Moon.Init;
  77.         OK := Moon.AddPoint(0, 0, 0);
  78.         SetRect(frame, 32000, 32000, -32000, -32000); (* almost-minimum empty rect *)
  79.  
  80.     (* Now set up the radius *)
  81.         SunRad := 50;
  82.         PlanetRad := 20;
  83.         MoonRad := 10;
  84.  
  85.     (* now lets move the planets and moons where they belong *)
  86.         Planet.Translate(100, 0, 0);
  87.         Moon.Translate(30, 0, 0);
  88.  
  89.     (* Now lets make them inheritances *)
  90.         thePass := Sun.FFPassOn;
  91.         Planet.FFInherit(thePass);
  92.         thePass := Planet.FFPassOn;
  93.         Moon.FFInherit(thePass);
  94.     end;
  95.  
  96.     procedure SolarSystem.Draw;
  97.         var
  98.             sunR: rect;
  99.             planetR: Rect;
  100.             moonR: Rect;
  101.             sunZ, planetZ, moonZ: Real;
  102.             theVector: Vector4;
  103.             priority: array[1..3] of record
  104.                     theRect: rect;
  105.                     deepZ: real
  106.                 end;
  107.  
  108.     begin
  109. (* Step 1: transform the object and all the points in it *)
  110.         sun.transform(FALSE);
  111.         planet.transform(FALSE); (* not the order! *)
  112.         moon.transform(TRUE);
  113. (* Step 2 : access the data base, get the transformed point and *)
  114. (*              calculate the frame for the solar object. We use a little trick: *)
  115. (*              we always access the first point (buffer 0, offset 0 ) so we   *)
  116. (*              don't need to calculate an offset                                             *)
  117.         theVector := sun.theBufs[0]^[0].transformed;
  118.         CalcObjectFrame(theVector, sunRad, sunR, sunZ);
  119.         theVector := Planet.theBufs[0]^[0].transformed;
  120.         CalcObjectFrame(theVector, planetRad, planetR, planetZ);
  121.         theVector := Moon.theBufs[0]^[0].transformed;
  122.         CalcObjectFrame(theVector, moonRad, moonR, moonZ);
  123.  
  124. (* step 3: sort the rects in their z-priority *)
  125.         priority[1].theRect := sunR;
  126.         priority[1].deepZ := sunZ;
  127.  
  128.         if planetZ > Priority[1].deepZ then
  129.             begin
  130.                 priority[2] := priority[1];
  131.                 priority[1].theRect := planetR;
  132.                 priority[1].deepZ := planetZ;
  133.             end
  134.         else
  135.             begin
  136.                 priority[2].theRect := planetR;
  137.                 priority[2].deepZ := planetZ
  138.             end;
  139.  
  140.         if moonZ > Priority[1].deepZ then
  141.             begin
  142.                 priority[3] := priority[2];
  143.                 priority[2] := priority[1];
  144.                 priority[1].theRect := moonR;
  145.                 priority[1].deepZ := moonZ;
  146.             end
  147.         else if moonZ > Priority[2].deepZ then
  148.             begin
  149.                 priority[3] := priority[2];
  150.                 priority[2].theRect := moonR;
  151.                 priority[2].deepZ := moonZ;
  152.             end
  153.         else
  154.             begin
  155.                 priority[3].theRect := moonR;
  156.                 priority[3].deepZ := moonZ
  157.             end;
  158.  
  159. (* Step 4 : Erase frame and redraw *)
  160.         EraseRect(frame);
  161.         FrameOval(Priority[1].theRect);
  162.         EraseOval(Priority[2].theRect);
  163.         FrameOval(Priority[2].theRect);
  164.         EraseOval(Priority[3].theRect);
  165.         FrameOval(Priority[3].theRect);
  166.  
  167. (* Step 5: calc new frame *)
  168.         oldFrame := frame;
  169.         UnionRect(sunR, planetR, frame);
  170.         UnionRect(frame, moonR, frame);
  171.  
  172.     end;
  173.  
  174.     procedure SolarSystem.Animate;
  175.     begin
  176.         Sun.Rotate(0 * degrees, 5 * degrees, 2 * degrees);
  177.         Planet.Rotate(0 * degrees, 5 * degrees, 0 * degrees);
  178.     end;
  179.  
  180.     procedure Check (theErr: integer);
  181.     begin
  182.         if theErr <> noErr then
  183.             DebugStr(InterPretError(theErr));
  184.     end;
  185.  
  186.     var
  187.         EyeLoc: Vector4;
  188.         theWindow: WindowPtr;
  189.         dummyL: LongInt;
  190.         theErr: integer;
  191.         copyRect: Rect;
  192.  
  193. begin
  194.     InitGrafSys;
  195.     theWindow := GetNew3DWindow(cTheWindow, pointer(-1));
  196.     SetVector4(EyeLoc, 0, 0, -1);
  197.     SetEye(TRUE, EyeLoc, 0, 0, 0, 90 * degrees, none);
  198.     New(Sol);
  199.     Sol.Init;
  200.     Sol.Draw;
  201.     repeat
  202.         Sol.Animate;
  203.         Sol.Draw;
  204.         Delay(1, dummyL);{}
  205.     until button;
  206.     repeat
  207.     until not button;
  208.     EraseRect(theWindow^.portRect);
  209.     Check(AttachOffscreen(theWindow, pointer(-1))); (* does automatic sanity check *)
  210.  
  211.     repeat
  212.         Check(BeginOSDraw(theWindow));
  213.         Sol.Animate;
  214.         Sol.Draw;
  215.         Check(EndOSDraw(theWindow));
  216.         UnionRect(Sol.frame, Sol.oldFrame, copyRect);
  217.  
  218.         Check(CopyOS2Screen(theWindow, copyRect, srcCopy));
  219.         Delay(1, dummyL);{}
  220.     until button;
  221.  
  222.     Check(CloseOffscreen(theWindow));
  223. end.